home *** CD-ROM | disk | FTP | other *** search
/ Programmers Heaven 2 / Programmers Heaven 2.iso / files / windows / ocx / ipack.exe / NEWMSGV.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-06-24  |  18.8 KB  |  549 lines
  1. VERSION 4.00
  2. Begin VB.Form NewMessage 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "New Message"
  6.    ClientHeight    =   8340
  7.    ClientLeft      =   1905
  8.    ClientTop       =   1980
  9.    ClientWidth     =   7410
  10.    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   8745
  21.    Left            =   1845
  22.    LinkTopic       =   "Form1"
  23.    ScaleHeight     =   8340
  24.    ScaleWidth      =   7410
  25.    Top             =   1635
  26.    Width           =   7530
  27.    Begin VB.Frame Frame1 
  28.       Caption         =   "Attachment Encoding"
  29.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  30.          Name            =   "MS Sans Serif"
  31.          Size            =   8.25
  32.          Charset         =   0
  33.          Weight          =   400
  34.          Underline       =   0   'False
  35.          Italic          =   0   'False
  36.          Strikethrough   =   0   'False
  37.       EndProperty
  38.       Height          =   855
  39.       Left            =   1320
  40.       TabIndex        =   13
  41.       Top             =   1920
  42.       Width           =   3135
  43.       Begin VB.OptionButton optUU 
  44.          Caption         =   "UU"
  45.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  46.             Name            =   "MS Sans Serif"
  47.             Size            =   8.25
  48.             Charset         =   0
  49.             Weight          =   400
  50.             Underline       =   0   'False
  51.             Italic          =   0   'False
  52.             Strikethrough   =   0   'False
  53.          EndProperty
  54.          Height          =   255
  55.          Left            =   1440
  56.          TabIndex        =   17
  57.          Top             =   480
  58.          Width           =   1215
  59.       End
  60.       Begin VB.OptionButton optQuotedPrintable 
  61.          Caption         =   "Quoted-Printable"
  62.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  63.             Name            =   "MS Sans Serif"
  64.             Size            =   8.25
  65.             Charset         =   0
  66.             Weight          =   400
  67.             Underline       =   0   'False
  68.             Italic          =   0   'False
  69.             Strikethrough   =   0   'False
  70.          EndProperty
  71.          Height          =   255
  72.          Left            =   1440
  73.          TabIndex        =   16
  74.          Top             =   240
  75.          Width           =   1575
  76.       End
  77.       Begin VB.OptionButton optBinhex40 
  78.          Caption         =   "Binhex40"
  79.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  80.             Name            =   "MS Sans Serif"
  81.             Size            =   8.25
  82.             Charset         =   0
  83.             Weight          =   400
  84.             Underline       =   0   'False
  85.             Italic          =   0   'False
  86.             Strikethrough   =   0   'False
  87.          EndProperty
  88.          Height          =   255
  89.          Left            =   120
  90.          TabIndex        =   15
  91.          Top             =   480
  92.          Width           =   1215
  93.       End
  94.       Begin VB.OptionButton optBase64 
  95.          Caption         =   "Base64"
  96.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  97.             Name            =   "MS Sans Serif"
  98.             Size            =   8.25
  99.             Charset         =   0
  100.             Weight          =   400
  101.             Underline       =   0   'False
  102.             Italic          =   0   'False
  103.             Strikethrough   =   0   'False
  104.          EndProperty
  105.          Height          =   255
  106.          Left            =   120
  107.          TabIndex        =   14
  108.          Top             =   240
  109.          Value           =   -1  'True
  110.          Width           =   1215
  111.       End
  112.    End
  113.    Begin VB.ComboBox cmbAttachments 
  114.       Appearance      =   0  'Flat
  115.       Height          =   315
  116.       Left            =   1320
  117.       Style           =   2  'Dropdown List
  118.       TabIndex        =   12
  119.       Top             =   1560
  120.       Width           =   5415
  121.    End
  122.    Begin VB.CommandButton Command1 
  123.       Appearance      =   0  'Flat
  124.       BackColor       =   &H80000005&
  125.       Caption         =   "&Attachments:"
  126.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  127.          Name            =   "MS Sans Serif"
  128.          Size            =   8.25
  129.          Charset         =   0
  130.          Weight          =   400
  131.          Underline       =   0   'False
  132.          Italic          =   0   'False
  133.          Strikethrough   =   0   'False
  134.       EndProperty
  135.       Height          =   315
  136.       Left            =   0
  137.       TabIndex        =   5
  138.       Top             =   1560
  139.       Width           =   1215
  140.    End
  141.    Begin VB.TextBox txtBCC 
  142.       Appearance      =   0  'Flat
  143.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  144.          Name            =   "MS Sans Serif"
  145.          Size            =   8.25
  146.          Charset         =   0
  147.          Weight          =   400
  148.          Underline       =   0   'False
  149.          Italic          =   0   'False
  150.          Strikethrough   =   0   'False
  151.       EndProperty
  152.       Height          =   330
  153.       Left            =   1320
  154.       TabIndex        =   4
  155.       Top             =   1200
  156.       Width           =   5895
  157.    End
  158.    Begin VB.TextBox txtCC 
  159.       Appearance      =   0  'Flat
  160.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  161.          Name            =   "MS Sans Serif"
  162.          Size            =   8.25
  163.          Charset         =   0
  164.          Weight          =   400
  165.          Underline       =   0   'False
  166.          Italic          =   0   'False
  167.          Strikethrough   =   0   'False
  168.       EndProperty
  169.       Height          =   330
  170.       Left            =   1320
  171.       TabIndex        =   3
  172.       Top             =   840
  173.       Width           =   5895
  174.    End
  175.    Begin VB.TextBox txtBody 
  176.       Appearance      =   0  'Flat
  177.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  178.          Name            =   "Courier New"
  179.          Size            =   8.25
  180.          Charset         =   0
  181.          Weight          =   400
  182.          Underline       =   0   'False
  183.          Italic          =   0   'False
  184.          Strikethrough   =   0   'False
  185.       EndProperty
  186.       Height          =   4875
  187.       Left            =   90
  188.       MultiLine       =   -1  'True
  189.       ScrollBars      =   3  'Both
  190.       TabIndex        =   6
  191.       Top             =   3360
  192.       Width           =   7140
  193.    End
  194.    Begin VB.CommandButton Cancel 
  195.       Appearance      =   0  'Flat
  196.       BackColor       =   &H80000005&
  197.       Cancel          =   -1  'True
  198.       Caption         =   "Cancel"
  199.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  200.          Name            =   "MS Sans Serif"
  201.          Size            =   8.25
  202.          Charset         =   0
  203.          Weight          =   400
  204.          Underline       =   0   'False
  205.          Italic          =   0   'False
  206.          Strikethrough   =   0   'False
  207.       EndProperty
  208.       Height          =   330
  209.       Left            =   120
  210.       TabIndex        =   8
  211.       Top             =   2280
  212.       Width           =   870
  213.    End
  214.    Begin VB.CommandButton Send 
  215.       Appearance      =   0  'Flat
  216.       BackColor       =   &H80000005&
  217.       Caption         =   "Send"
  218.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  219.          Name            =   "MS Sans Serif"
  220.          Size            =   8.25
  221.          Charset         =   0
  222.          Weight          =   400
  223.          Underline       =   0   'False
  224.          Italic          =   0   'False
  225.          Strikethrough   =   0   'False
  226.       EndProperty
  227.       Height          =   330
  228.       Left            =   120
  229.       TabIndex        =   7
  230.       Top             =   1920
  231.       Width           =   870
  232.    End
  233.    Begin VB.TextBox txtSubject 
  234.       Appearance      =   0  'Flat
  235.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  236.          Name            =   "MS Sans Serif"
  237.          Size            =   8.25
  238.          Charset         =   0
  239.          Weight          =   400
  240.          Underline       =   0   'False
  241.          Italic          =   0   'False
  242.          Strikethrough   =   0   'False
  243.       EndProperty
  244.       Height          =   330
  245.       Left            =   1320
  246.       TabIndex        =   2
  247.       Top             =   480
  248.       Width           =   5895
  249.    End
  250.    Begin VB.TextBox txtTo 
  251.       Appearance      =   0  'Flat
  252.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  253.          Name            =   "MS Sans Serif"
  254.          Size            =   8.25
  255.          Charset         =   0
  256.          Weight          =   400
  257.          Underline       =   0   'False
  258.          Italic          =   0   'False
  259.          Strikethrough   =   0   'False
  260.       EndProperty
  261.       Height          =   330
  262.       Left            =   1320
  263.       TabIndex        =   1
  264.       Top             =   120
  265.       Width           =   5895
  266.    End
  267.    Begin MailLib.mMail Mail1 
  268.       Left            =   6600
  269.       Top             =   2280
  270.       _Version        =   327680
  271.       _ExtentX        =   847
  272.       _ExtentY        =   847
  273.       _StockProps     =   0
  274.       Blocking        =   0   'False
  275.       Debug           =   1
  276.       Host            =   ""
  277.       Timeout         =   0
  278.       ConnectType     =   0
  279.       PopPort         =   110
  280.       SmtpPort        =   25
  281.    End
  282.    Begin MSComDlg.CommonDialog cmdialog1 
  283.       Left            =   6120
  284.       Top             =   2280
  285.       _ExtentX        =   847
  286.       _ExtentY        =   847
  287.       _Version        =   327680
  288.       FontSize        =   3.48643e-38
  289.    End
  290.    Begin VB.Label Label4 
  291.       Alignment       =   1  'Right Justify
  292.       Appearance      =   0  'Flat
  293.       BackColor       =   &H00C0C0C0&
  294.       Caption         =   "&BCC:"
  295.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  296.          Name            =   "MS Sans Serif"
  297.          Size            =   8.25
  298.          Charset         =   0
  299.          Weight          =   400
  300.          Underline       =   0   'False
  301.          Italic          =   0   'False
  302.          Strikethrough   =   0   'False
  303.       EndProperty
  304.       ForeColor       =   &H80000008&
  305.       Height          =   270
  306.       Left            =   120
  307.       TabIndex        =   11
  308.       Top             =   1200
  309.       Width           =   1065
  310.    End
  311.    Begin VB.Label Label3 
  312.       Alignment       =   1  'Right Justify
  313.       Appearance      =   0  'Flat
  314.       BackColor       =   &H00C0C0C0&
  315.       Caption         =   "&CC:"
  316.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  317.          Name            =   "MS Sans Serif"
  318.          Size            =   8.25
  319.          Charset         =   0
  320.          Weight          =   400
  321.          Underline       =   0   'False
  322.          Italic          =   0   'False
  323.          Strikethrough   =   0   'False
  324.       EndProperty
  325.       ForeColor       =   &H80000008&
  326.       Height          =   270
  327.       Left            =   120
  328.       TabIndex        =   10
  329.       Top             =   840
  330.       Width           =   1065
  331.    End
  332.    Begin VB.Line Line2 
  333.       BorderColor     =   &H00FFFFFF&
  334.       X1              =   0
  335.       X2              =   7260
  336.       Y1              =   2880
  337.       Y2              =   2880
  338.    End
  339.    Begin VB.Line Line1 
  340.       BorderColor     =   &H00808080&
  341.       X1              =   120
  342.       X2              =   7425
  343.       Y1              =   2880
  344.       Y2              =   2880
  345.    End
  346.    Begin VB.Label Label2 
  347.       Alignment       =   1  'Right Justify
  348.       Appearance      =   0  'Flat
  349.       BackColor       =   &H00C0C0C0&
  350.       Caption         =   "&Subject:"
  351.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  352.          Name            =   "MS Sans Serif"
  353.          Size            =   8.25
  354.          Charset         =   0
  355.          Weight          =   400
  356.          Underline       =   0   'False
  357.          Italic          =   0   'False
  358.          Strikethrough   =   0   'False
  359.       EndProperty
  360.       ForeColor       =   &H80000008&
  361.       Height          =   270
  362.       Left            =   105
  363.       TabIndex        =   9
  364.       Top             =   450
  365.       Width           =   1065
  366.    End
  367.    Begin VB.Label Label1 
  368.       Alignment       =   1  'Right Justify
  369.       Appearance      =   0  'Flat
  370.       BackColor       =   &H00C0C0C0&
  371.       Caption         =   "&To:"
  372.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  373.          Name            =   "MS Sans Serif"
  374.          Size            =   8.25
  375.          Charset         =   0
  376.          Weight          =   400
  377.          Underline       =   0   'False
  378.          Italic          =   0   'False
  379.          Strikethrough   =   0   'False
  380.       EndProperty
  381.       ForeColor       =   &H80000008&
  382.       Height          =   270
  383.       Left            =   90
  384.       TabIndex        =   0
  385.       Top             =   120
  386.       Width           =   1065
  387.    End
  388. Attribute VB_Name = "NewMessage"
  389. Attribute VB_Creatable = False
  390. Attribute VB_Exposed = False
  391. Option Explicit
  392. ' For spacing during Form_Resize
  393. Const Margin = 2
  394. Dim State As Integer
  395. Const StateSending = 1
  396. Const StateConnecting = 2
  397. Const StateDisconnecting = 3
  398. Private Sub Cancel_Click()
  399.     Unload Me
  400. End Sub
  401. Private Sub Command1_Click()
  402.     Dim boundary As Double
  403.     Dim fEncode As Integer
  404.     On Error Resume Next
  405.     cmdialog1.Action = 1
  406.     If (Err <> 0) Then
  407.         MsgBox Error
  408.     End If
  409.     On Error GoTo 0
  410.     cmbAttachments.AddItem cmdialog1.filename
  411.     cmbAttachments.ListIndex = cmbAttachments.ListCount - 1
  412.     If (Mail1.ContentType <> "multipart") Then
  413.         boundary = Fix(Rnd * 100000000000#)
  414.         Mail1.ContentType = "multipart"
  415.         Mail1.ContentSubtype = "mixed"
  416.         Mail1.ContentSubtypeParameters = "boundary=" & CStr(boundary) & "_boundary"
  417.         Mail1.MultipartBoundary = CStr(boundary) & "_boundary"
  418.     End If
  419.     Mail1.Action = MailActionCreatePart
  420.     Mail1.Action = MailActionDescend
  421.     fEncode = False
  422.     If (optBinhex40.Value) Then
  423.         Mail1.ContentTransferEncoding = "mac-binhex40"
  424.     ElseIf (optUU.Value) Then
  425.         Mail1.ContentTransferEncoding = "x-uuencode"
  426.     ElseIf (optQuotedPrintable.Value) Then
  427.         Mail1.ContentTransferEncoding = "quoted-printable"
  428.     Else
  429.         Mail1.ContentTransferEncoding = "base64"
  430.     End If
  431.     Select Case LCase(Mid(cmdialog1.FileTitle, InStr(cmdialog1.FileTitle, ".")))
  432.         Case ".zip"
  433.             Mail1.ContentType = "application"
  434.             Mail1.ContentSubtype = "x-zip-compressed"
  435.             Mail1.ContentSubtypeParameters = "name=" & Chr(34) & cmdialog1.filename & Chr(34)
  436.             Mail1.ContentDisposition = "attachment; filename=" & Chr(34) & cmdialog1.FileTitle & Chr(34)
  437.             fEncode = True
  438.         Case ".txt"
  439.             Dim S As String
  440.             
  441.             Mail1.ContentType = "text"
  442.             Mail1.ContentSubtype = "plain"
  443.             Mail1.ContentSubtypeParameters = "charset=us-ascii"
  444.             Mail1.ContentTransferEncoding = "7bit"
  445.             Mail1.ContentDisposition = "inline; filename=" & Chr(34) & cmdialog1.filename & Chr(34)
  446.             '
  447.             ' note this only works for files < 32k
  448.             '
  449.             Open cmdialog1.filename For Binary As #1
  450.             S = String(LOF(1), 0)
  451.             Get #1, , S
  452.             Mail1.Body(0) = S
  453.             Close #1
  454.         Case ".gif", ".bmp", ".jpg"
  455.             Mail1.ContentType = "image"
  456.             Mail1.ContentSubtype = LCase(Mid(cmdialog1.FileTitle, InStr(cmdialog1.FileTitle, ".") + 1))
  457.             Mail1.ContentDisposition = "inline; filename=" & Chr(34) & cmdialog1.FileTitle & Chr(34)
  458.             fEncode = True
  459.         Case Else
  460.             Mail1.ContentType = "application"
  461.             Mail1.ContentSubtype = "octet-stream"
  462.             Mail1.ContentDisposition = "attachment; filename=" & Chr(34) & cmdialog1.FileTitle & Chr(34)
  463.             fEncode = True
  464.     End Select
  465.     If (fEncode) Then
  466.         Mail1.Flags = MailSrcIsFile Or MailDstIsBody
  467.         Mail1.SrcFilename = cmdialog1.filename
  468.         Mail1.Action = MailActionEncode
  469.     End If
  470.     Mail1.Action = MailActionAscend
  471. End Sub
  472. Private Sub Form_Load()
  473.    Mail1.From = g_emailaddr
  474.    Mail1.To = txtTo.Text
  475.    End Sub
  476. Private Sub Form_Resize()
  477.    If Me.WindowState = 1 Then
  478.       Exit Sub
  479.       End If
  480.       
  481.    Line1.X1 = 0
  482.    Line1.X1 = 0
  483.    Line2.X2 = Me.ScaleWidth
  484.    Line2.X2 = Me.ScaleWidth
  485.    txtTo.Width = Me.ScaleWidth - txtTo.Left - Margin * 2
  486.    txtSubject.Width = txtTo.Width
  487.    txtCC.Width = txtTo.Width
  488.    txtBCC.Width = txtTo.Width
  489.    cmbAttachments.Width = txtTo.Width
  490.    txtBody.Left = Margin
  491.    txtBody.Width = Me.ScaleWidth - 2 * Margin
  492.    txtBody.Top = Line1.Y2 + Margin * 5
  493.    txtBody.Height = Me.ScaleHeight - txtBody.Top - Margin * 5
  494.    End Sub
  495. Private Sub Mail1_AsyncError(ByVal ErrorCode As Integer, ByVal ErrorMessage As String)
  496.    MsgBox ErrorMessage
  497.    State = StateDisconnecting
  498.    Mail1.Action = MailActionDisconnect
  499.    End Sub
  500. Private Sub MAIL1_Debug(ByVal message As String)
  501.     Debug.Print message
  502. End Sub
  503. Private Sub Mail1_Done()
  504.     Screen.MousePointer = 0
  505.     Select Case State
  506.         Case StateConnecting
  507.             State = StateSending
  508.             Mail1.Flags = MailDstIsHost
  509.             Mail1.Action = MailActionWriteMessage
  510.             If (Mail1.Blocking = True) Then
  511.                 Mail1_Done
  512.             End If
  513.         Case StateSending
  514.             State = StateDisconnecting
  515.             Mail1.Action = MailActionDisconnect
  516.             If (Mail1.Blocking = True) Then
  517.                 Mail1_Done
  518.             End If
  519.         Case StateDisconnecting
  520.             Unload Me
  521.     End Select
  522. End Sub
  523. Private Sub Send_Click()
  524.     Mail1.To = txtTo.Text
  525.     Mail1.Subject = txtSubject.Text
  526.     Mail1.From = g_username & " <" & g_emailaddr & ">"
  527.     Mail1.CC = txtCC.Text
  528.     Mail1.BCC = txtBCC.Text
  529.     Mail1.Headers(Mail1.HeadersCount) = "X-Mailer: Mabry"
  530.     Mail1.Host = g_SmtpHost
  531.     Mail1.EMailAddress = Chr(34) & g_username & Chr(34) & "<" & g_emailaddr & ">"
  532.     Mail1.MessageID = Year(Now) & Month(Now) & Day(Now) & Fix(Timer) & "_MabryMail"
  533.     If (Mail1.Parts > 0 And txtBody.Text <> "") Then
  534.         Mail1.Part = 0
  535.         Mail1.Action = MailActionCreatePart
  536.         Mail1.Action = MailActionDescend
  537.         Mail1.Body(0) = txtBody.Text
  538.         Mail1.Action = MailActionAscend
  539.     Else
  540.         Mail1.Body(0) = txtBody.Text
  541.     End If
  542.     Screen.MousePointer = 11
  543.     State = StateConnecting
  544.     Mail1.Action = MailActionConnect
  545.     If (Mail1.Blocking = True) Then
  546.        Mail1_Done
  547.     End If
  548. End Sub
  549.